Исходный код

Option Explicit
Call ShowAttrInfo()


'==============================================================================
'Вывести информацию по всем атрибутам объекта TDMSApplication, а также
'протестировать создание/удаление атрибута в этой коллекции.
'==============================================================================
Sub ShowAttrInfo()

        Dim attr, ADef, ACol, tAttrDefTypes, num, RetVal, s, strVal
        ' Перечисление типов данных TDMS
        tAttrDefTypes =Array ("tdmString", "tdmInteger", "tdmReal", "tdmBool", _
            "tdmInteger64", "tdmDate", "tdmClassifier", "tdmObjectLink", "tdmList", _
            "tdmUserLink", "tdmFileLink", "tdmTable")
        
        'Получить коллекцию системных атрибутов
        Set ACol = ThisApplication.Attributes
        
        'Если коллекция пустая, дадим пользователю права на ее редактирование.
        'Пусть он создаст/удалит в этой коллекции атрибут первого попавшегося типа 
        If ACol.Count = 0 Then
                
                'Дать пользователю спец. права на редактирование коллекции
                ACol.Permissions = SysAdminPermissions
                
                'Получить ссылку на первый тип атрибута (из глобальной коллекции)
                Set ADef = ThisApplication.AttributeDefs(0)
                
                'Проверить, есть атрибут этого типа в коллекции системных или еще нет
                If ACol.Has(ADef) <> True Then
                
                        Set attr = ACol.Create(ADef) 'если нет, создать новый атрибут
                        RetVal = Msgbox("Атрибут типа """ & ADef.Description & """ успешно добавлен" & Chr(13) &_
                                            " в коллекцию системных атрибутов. Удалить его?", vbQuestion + vbYesNo)
                        
                        'Если пользователь попросил, удалить вновь созданный атрибут
                        If RetVal <> vbNo Then    ACol.Remove attr
                End If
                
                'На этом закончить работу.
                Exit Sub
        End If
                
        'Если коллекция системных атрибутов была непустой, вывести описания 
        'каждого элемента коллекции в Окно сообщений.
        For Each attr In ACol
        
                s = ACol.Index(attr)+1 & ") " & attr.Description & Chr(13)' № п/п, описание
                s = s & "SysID: " & attr.AttributeDefName & Chr(13) 'системное имя типа
                s = s & "Тип данных: " & tAttrDefTypes(attr.Type) & Chr(13) 'тип данных
                
                'Добавить значение атрибута, если он непустой (проверим свойство Empty. 
                'Нюанс: для табличных атрибутов свойство Empty всегда имеет значение TRUE).
                If attr.Type = tdmTable Then
                        strVal = "таблица, строк: " & attr.Rows.Count
                ElseIf attr.Empty <> FALSE Then 
                        strVal = "не присвоено"
                Else    strVal = attr.Value
                End If
                s = s & "Значение: " & strVal 
                
                'Добавить описание в Окно сообщений
                ThisApplication.AddNotify s
        Next
End Sub
'==============================================================================